PC Shareware 1997 February/PC Shareware 1997-02.iso/programy/e!/api/beginend.pa_/beginend.PAS

Pascal/Delphi Source File | 1995-03-05 | 7.1 KB | 257 lines

{************************************************}
{                         }
{ E! for Windows                 }
{ (c) - MainSoft sarl - 1992, 1994         }
{                         }
{ Sample Extension DLL - version 2.0         }
{                         }
{ This DLL implements an extension to the     }
{ Check Brace function. The original function     }
{ doesn't take into account the BEGIN/END,       }
{ CASE/END or REPEAT/UNTIL pairs of the Pascal     }
{ language. If loaded, this DLL will extend the  }
{ search and find the above matching pairs.     }
{                         }
{************************************************}

(*
To use this DLL simply load it from the user menu or add its name to the
list of autoloaded Extension DLLs by using the Autoload dialog box from
the User Menu of EW. That's all. This extension cannot be executed because
it only adds a hook to the CheckBrace function and exports no EWExecute
function.

BEGINEND will check if the standard CheckBrace function failed and will try
to find a BEGIN/END, CASE/END or REPEAT/UNTIL pair. BEGINEND will fail if the
word at the cursor position doesn't belong to that list.

Once BEGINEND has been loaded, Ctrl H (default assignment) will trigger the
CheckBrace function and pass along control to BEGINEND in case of failure.

BEGINEND works in both directions. If you set the cursor under BEGIN, CASE or
REPEAT, it will search forward for END or UNTIL, otherwise if you set the
cursor under UNTIL or END, it will look backward for a matching BEGIN, CASE
or REPEAT.

Of course, nested pairs are ignored as well as keywords enclosed within
comment braces.

BEGINEND uses the FuncExitHook provided by the EW API and some other API
services giving information about the current Editor.
*)

{$I compdir.inc}
{$C MOVEABLE PRELOAD DISCARDABLE}

library BeginEnd;

uses WinTypes, EWApImp2, Strings;

{$I ewuser.inc}

var
  SaveExit  : Pointer;
  BufIndex,
  LineIndex,
  MaxIndex  : integer;
  Len        : word;


function SearchMatchingItem : boolean;

type
  longrec = record
    LoW, HiW : integer;
  end;

const
  MAXLEN = 255;

var
  newch,
  ch        : char;
  CommentLevel    : integer;
  PairCount    : word;
  Linebuffer    : array[0..MAXLEN] of char;
  bForward,
  bDone     : boolean;

  function GetChar : char;
 {-Retrieve characters from the text flow}
  begin
    if bForward then begin
      Inc(BufIndex);
      if BufIndex >= Len then begin
    Inc(LineIndex);
    if LineIndex <= MaxIndex then begin
      while StrUpper(StrCopy(LineBuffer, EwGetLineAt(LineIndex)))[0] = #0 do begin
        Inc(LineIndex);
        if LineIndex > Maxindex then begin
          GetChar := #0;
          Exit;
        end;
      end;
      Len := StrLen(LineBuffer);
      BufIndex := 0;
    end else begin
      GetChar := #0;
      Exit;
    end;
      end;
    end else begin
      Dec(BufIndex);
      if BufIndex < 0 then begin
    Dec(LineIndex);
    if LineIndex >= 0 then begin
      while StrUpper(StrCopy(LineBuffer, EwGetLineAt(LineIndex)))[0] = #0 do begin
        Dec(LineIndex);
        if LineIndex < 0 then begin
          GetChar := #0;
          Exit;
        end;
      end;
      Len := StrLen(LineBuffer);
      BufIndex := Pred(Len);
    end else begin
      GetChar := #0;
      Exit;
    end;
      end;
    end;
    GetChar := LineBuffer[BufIndex];
  end;

  function MatchPattern(ch : char) : boolean;
 {-Verify if the word beginning at the cursor position match a list member}
  var
    MatchStr : array[0..6] of char;
    MatchEnd : word;
    P         : PChar;
  const
    Delimiters : set of char =
      ['.', ' ', ',', ';', ':', '\', '/', '(', ')', '{', '}', '[', ']', '-'];
  begin
    MatchPattern := false;
    if CommentLevel <> 0 then
      Exit;
    case ch of
      'B' : StrCopy(MatchStr, 'BEGIN');
      'R' : StrCopy(MatchStr, 'REPEAT');
      'U' : StrCopy(MatchStr, 'UNTIL');
      'C' : StrCopy(MatchStr, 'CASE');
      'E' : StrCopy(MatchStr, 'END');
    end;
    MatchEnd := StrLen(MatchStr) + BufIndex;
    P := StrPos(LineBuffer + BufIndex, MatchStr);
    MatchPattern :=
      (P <> nil)
      and
      (P - LineBuffer = BufIndex)
      and
      ((BufIndex = 0) or (LineBuffer[Pred(BufIndex)] in [' ', ';']))
      and
      ((MatchEnd = Len) or ((MatchEnd < Len) and (LineBuffer[MatchEnd] in Delimiters)));
  end;

begin
 {-Get current cursor position}
  BufIndex := EWGetCaretPosX;
  LineIndex := EWGetCaretPosY;
 {-Get number of lines in current Editor}
  MaxIndex := Pred(EWGetLineCount);
 {-Get the current line}
  StrUpper(StrCopy(LineBuffer, EwGetLineAt(LineIndex)));
 {-Initialize search data}
  Len := StrLen(LineBuffer);
  CommentLevel := 0;
  bDone := false;
  bForward := Upcase(LineBuffer[BufIndex]) in ['B', 'C', 'R'];
  if bForward then
    Dec(BufIndex)
  else
    Inc(BufIndex);
  SearchMatchingItem := false;
  if not MatchPattern(GetChar) then
    Exit
  else
    PairCount := 1;
  repeat
   {-Read character from text stream and update search variables}
    ch := Upcase(GetChar);
    case ch of
      '{' : Inc(CommentLevel);
      '}' : Dec(CommentLevel);
      '(' : if bForward and (GetChar = '*') then
          Inc(CommentLevel);
      ')' : if not bForward and (GetChar = '*') then
          Inc(CommentLevel);
      '*' : begin
          newch := GetChar;
          if (bForward and (newch = ')')
          or (not bForward and (newch = '('))) then
        Dec(CommentLevel)
        end;
      'B',
      'R',
      'C' : if MatchPattern(ch) then
          if bForward then
        Inc(PairCount)
          else
        Dec(PairCount);
      'U',
      'E' : if MatchPattern(ch) then
          if bForward then
        Dec(PairCount)
          else
        Inc(PairCount);
    end;
    if PairCount = 0 then begin
   {-Nesting level returned to 0. A matching sequence has been found}
      SearchMatchingItem := true;
      EWGotoXY(BufIndex, LineIndex);
      bDone := true;
    end;
  until bDone or (ch = #0);
 {-See comments in FunctionExitHook}
  if not bDone then
    EWWriteMessage('No matching sequence found')
  else
    EWWriteMessage(''); {-Clear previous error messages}
  SearchMatchingItem := bDone;
end;

function FuncExitHook(command : word; pRetCode : PInteger) : integer; export;
{-Check whether the CheckBrace function succeeded.}
{ If not, call SearchMatchingItem}
begin
  FuncExitHook := 0;
 {-Although the present version of the EW API doesn't check the return code}
 { from the FuncExitHook functions, it is good practice to set this value  }
 { to 0.}
  if (command = ew_CheckBrace) and (pRetcode^ <> 0) then
    if SearchMatchingItem then
      pRetcode^ := 0 {-Success. Overwrite error code returned by CheckBrace}
    else
      pRetcode^ := ewerr_EXTFAILED; {-Unique exit code signaling that the}
                    { extension function failed.}
  {-You may also leave pRetcode^ unchanged and let EW display its usual }
  { message. In that case EW would issue no message at all, so it's pre-}
  { ferable to handle this ourselves.}

end;

procedure LibExit; far;
begin
  EWRemoveHook(EWHook_FunctionExit, @FuncExitHook);
  ExitProc := SaveExit;
end;

exports
  FuncExitHook     index 1;

begin
  EWSetHook(EWHook_FunctionExit, @FuncExitHook);
  SaveExit := ExitProc;
  ExitProc := @LibExit;
end.